subroutine calcwmbejg(iijka, iabij, &
          t1, t2, r1, r2, &
          wmbej, icore, wmbej_c, icore_c) 
use mod_size
use mod_iop
use mod_orbit
use mod_ioff 
implicit none
real*4, intent(inout),device :: t1(*), t2(*), r1(*), r2(*) 
real*4, intent(inout),device :: iijka(*), iabij(*)
real*4, intent(inout),device :: wmbej(*)
real*4, intent(inout),device :: icore(*)
real*4, intent(inout) :: wmbej_c(*), icore_c(*)
integer i0, i1, i2, i3, i4, nsize
integer, external :: idsymsoc
real*8, external :: nrm2so
i0 = 1
i1 = i0 + nvvoo*isd
i2 = i1 + nvvoo*isd
i3 = i2 + nvvoo*isd
i4 = i3 + nvvoo*isd
!
!====EMBJ AAAA==========================
!
call myicopy_g(wmbej_c(ioi4(1)), wmbej, nioi41)
!
!iijka(MN,JE)*t1(BN)
call itranspso(iijka(ioi2(1)), icore(i0), popa, popa, 0, popa, vrta, 1, 1) 
call iexpso(icore(i0), icore(i1), popa, vrta, 1, 0, popa, popa, 0, 1, 1) 
!
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, popa, & 
                  popa, vrta, 1, popa, vrta, icore(i0), 1, 1.d0, 0.d0, 1)
! tmpe(JE,MB)
call sstgenso(icore(i0), icore(i1), nsize, popa, vrta, popa, vrta, & 
              icore, 1, '2341')
call axpyso(nioi41, 1.d0, icore(i1), 1, wmbej, 1)
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1)
 write(6,*)'norm of wmbejaaaa 1 ', nrm2so(nsize, wmbej, 1)
!
!this is to do wmbej = wmbej - t1(fj)*t1(bn)*<ef||mn>
!--<EF||MN>*t1(FJ)*t1(BN)
call itranspso(iabij(ioi3(1)), icore(i0), vrta, vrta, 0, popa, popa, 0, 1) 
call iexpso(icore(i0), icore(i1), popa, popa, 0, 0, vrta, vrta, 0, 1, 1)
call VpqrmVms_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, vrta, &
                 popa, popa, 0, vrta, popa, icore(i0), 1, 1.d0, 0.d0)
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa after AAAA', nrm2so(nsize, t2(ioi3(1)), 1) 
!--<MN||EJ> to tmp(EJ,MN) 
call itranspso(icore(i0), icore(i1), popa, popa, 0, vrta, popa, 1, 1)
call iexpso(icore(i1), icore(i0), vrta, popa, 1, 0, popa, popa, 0, 1, 1)
call VpqrmVsm_to_Vpqrs(icore(i0), t1(ifvo(1)), 1, 1, popa, &
                 vrta, popa, 1, popa, vrta, icore(i1), 1, 1.d0, 0.d0)
!--tmp(EJ,MB) to EMBJ
call sstgenso(icore(i1), icore(i0), nsize, vrta, popa, popa, vrta, &
              icore, 1, '1342')
call axpyso(nioi41, -1.d0, icore(i0), 1, wmbej, 1)
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1)
 write(6,*)'norm of wmbejaaaa 2 ', nrm2so(nsize, wmbej, 1)
!
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
! write(6,*)'norm of t2aa after AAAA', nrm2so(nsize, t2(ioi3(1)), 1) 
!this is to do wmbej = wmbej + 0.5*t2(bf,jn)*<ef||mn>
!----<EF||MN>*T2(FB,JN)
!iabij(EF,MN) to iabij(EM,FN)
call iexpso(iabij(ioi3(1)), icore(i2), vrta, vrta, 0, 1, &
                    popa, popa, 0, 0, 1)
call iexpso(icore(i2), icore(i1), vrta, vrta, 1, 0, &
                    popa, popa, 0, 1, 1)
call sstgenso(icore(i1), icore(i0), nsize, vrta, vrta, popa, popa,&
               icore, 1, '1324')
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa after AAAA7', nrm2so(nsize, t2(ioi3(1)), 1) 
!t2(BF,JN) to t2(BJ,FN)
call iexpso(t2(ioi3(1)), icore(i1), vrta, vrta, 0, 1,&
                    popa, popa, 0, 0, 1)
call iexpso(icore(i1), icore(i2), vrta, vrta, 1, 0, &
                    popa, popa, 0, 1, 1)
call sstgenso(icore(i2), icore(i1), nsize, vrta, vrta, popa, popa, &
               icore, 1, '1324')
call VpqmnVrsmn_to_Vpqrs(icore(i0), icore(i1), 1, 1, &
                  vrta, popa, 1, vrta, popa, 1, vrta, popa, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1)
 write(6,*)'norm of wmbejaaaa 3 ', nrm2so(nsize, wmbej, 1)
!---<Ef||Mn>*T2(Bf,Jn) AAAA
call sstgenso(iabij(ioi3(2)), icore(i0), nsize, vrta, vrtb, popa, popb,&
               icore, 1, '1324')
call sstgenso(t2(ioi3(2)), icore(i1), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1324')
call VpqmnVrsmn_to_Vpqrs(icore(i0), icore(i1), 1, 1, &
                  vrtb, popb, 1, vrta, popa, 1, vrta, popa, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!------------------------------------------------------
! R2AAAAR: P(ij)P(ab)  T2AA(AE,IM)*WMBEJ(EM,BJ)
!
 call iexpso(t2(ioi3(1)), icore(i1), vrta, vrta, 0, 1, popa, popa, 0, 0, 1)
 call iexpso(icore(i1), icore(i0), vrta, vrta, 1, 0, popa, popa, 0, 1, 1)
 call sstgenso(icore(i0), icore(i1), nsize, vrta, vrta, &
             popa, popa, icore, 1, '1324')
 call VpqmnVmnrs_to_Vpqrs(icore(i1), wmbej, 1, 1, &
                vrta, popa, 1, vrta, popa, 1, &
                vrta, popa, 1, icore(i2), 1, 1.d0, 0.d0)
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1)
 call sstgenso(icore(i2), icore(i1), nsize, vrta, popa, &
             vrta, popa, icore, 1, '2413')
 call iassymso(icore(i1), icore(i0), 1, popa, popa, vrta, vrta, 1)
 call itranspso(icore(i0), icore(i1), popa, popa, 1, vrta, vrta, 0, 1)
 call iassymso(icore(i1), icore(i0), 1, vrta, vrta, popa, popa, 0)
 call axpyso(nioi31, 1.d0, icore(i0), 1, r2(ioi3(1)), 1)
!
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1)
 write(6,*)'norm of wmbejaaaa ', nrm2so(nsize, wmbej, 1) 
 write(6,*)'norm of r2aa 1', nrm2so(nioi31, r2(ioi3(1)), 1) 
!R2ABAB T2AB(Eb,Mj)W(EM,AI)
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1), nsize, vrta, vrtb, &
             popa, popb, icore, 1, '1324')
 CALL VmnpqVmnrs_to_Vpqrs(WMBEJ, ICORE(i1), 1, 1, &
                vrta, popa, 1, vrta, popa, 1, &
                vrtb, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), icore(i1), nsize, &
           vrta, popa, vrtb, popb,ICORE,1,'1324')
  write(6,*)'norm of r2ab 1', nrm2so(nioi32, r2(ioi3(2)), 1) 
 CALL AXPYSO(nioi32, 1.d0, ICORE(i1), 1, R2(ioi3(2)), 1)
  write(6,*)'norm of r2ab 2', nrm2so(nioi32, r2(ioi3(2)), 1) 
!
!====EmBj ABAB============================================
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa after ABAB', nrm2so(nsize, t2(ioi3(1)), 1) 
call myicopy_g(wmbej_c(ioi4(2)), wmbej, nioi42)
!
!iijka(mN,jE)*t1(BN)
call itranspso(iijka(ioi2(4)), icore(i1), popb, popa, 1, popb, vrta, 1, 1) 
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, popa, & 
                  popb, vrta, 1, popb, vrta, icore(i0), 1, 1.d0, 0.d0)
! tmpe(jE,mB)
call sstgenso(icore(i0), icore(i1), nsize, popb, vrta, popb, vrta, & 
   icore, 1, '2341')
call axpyso(nioi42, 1.d0, icore(i1), 1, wmbej, 1)
!-----------this is to do wmbej = wmbej - t1(fj)*t1(bn)*<ef||mn>
!--<Ef||mN>*t1(fj)*t1(BN)=-<Ef|Nm>*t1(fj)*t1(BN)
call itranspso(iabij(ioi3(2)), icore(i1), vrta, vrtb, 1, popa, popb, 1, 1)
call VpqrmVms_to_Vpqrs(icore(i1), t1(ifvo(2)), 1, 1, vrtb, &
                 popa, popb, 1, vrta, popb, icore(i2), 1, 1.d0, 0.d0)
!--<Nm,Ej> to (Ej,Nm)
call itranspso(icore(i2), icore(i0), popa, popb, 1, vrta, popb, 1, 1)
call isymtrso(icore(i0), icore(i2), vrta, popb, 1, 0, popa, popb, 1, 1, 1)
call VpqrmVsm_to_Vpqrs(icore(i2), t1(ifvo(1)), 1, 1, popa, &
                 vrta, popb, 1, popb, vrta, icore(i1), 1, 1.d0, 0.d0)
!--tmp(Ej,mB) to EmBj
call sstgenso(icore(i1), icore(i2), nsize, vrta, popb, popb, vrta, &
              icore, 1, '1342')
call axpyso(nioi42,  1.d0, icore(i2), 1, wmbej, 1)
!
!this is to do wmbej = wmbej + 0.5*t2(bf,jn)*<ef||mn>
!
!---<Ef|mN>*t2(Bf,jN)=<Ef|Nm>*t2(Bf,Nj)
call sstgenso(iabij(ioi3(2)), icore(i0), nsize, vrta, vrtb, popa, popb,&
               icore, 1, '1423')
call sstgenso(t2(ioi3(2)), icore(i1), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1423')
call VpqmnVrsmn_to_Vpqrs(icore(i0), icore(i1), 1, 1, &
                  vrtb, popa, 1, vrta, popb, 1, vrta, popb, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!--------------------------------------------------------------
!R2ABAB -T2AB(Eb,Im)W(Em,Aj)
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1), nsize, vrta, vrtb, &
                popa, popb, ICORE, 1, '2314')
 CALL VpqmnVmnrs_to_Vpqrs(ICORE(i1), WMBEJ, 1, 1, &
                vrta, popb, 1, vrtb, popa, 1, &
                vrta, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), ICORE(i1),nsize, &
               vrtb, popa, vrta, popb, ICORE,1,'3124')
 CALL AXPYSO(nioi32, 1.d0, ICORE(i1), 1, R2(ioi3(2)), 1)
  write(6,*)'norm of r2ab 2', nrm2so(nioi32, r2(ioi3(2)), 1) 
!
!====embj BBBB==========================================================
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa after BBBB', nrm2so(nsize, t2(ioi3(1)), 1) 
call myicopy_g(wmbej_c(ioi4(3)), wmbej, nioi43)
!
!iijka(mn,je)*t1(bn)
call itranspso(iijka(ioi2(3)), icore(i0), popb, popb, 0, popb, vrtb, 1, 1) 
call iexpso(icore(i0), icore(i1), popb, vrtb, 1, 0, popb, popb, 0, 1, 1) 
!
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(2)), 1, 1, popb, & 
                  popb, vrtb, 1, popb, vrtb, icore(i0), 1, 1.d0, 0.d0, 1)
! tmpe(je,mb)
call sstgenso(icore(i0), icore(i1), nsize, popb, vrtb, popb, vrtb, & 
              icore, 1, '2341')
call axpyso(nioi43, 1.d0, icore(i1), 1, wmbej, 1)
!-----------this is to do wmbej = wmbej - t1(fj)*t1(bn)*<ef||mn>
!--<ef||mn>*t1(fj)*t1(bn)
call itranspso(iabij(ioi3(3)), icore(i0), vrtb, vrtb, 0, popb, popb, 0, 1)
call iexpso(icore(i0), icore(i1), popb, popb, 0, 0, vrtb, vrtb, 0, 1, 1)
call VpqrmVms_to_Vpqrs(icore(i1), t1(ifvo(2)), 1, 1, vrtb, &
                 popb, popb, 0, vrtb, popb, icore(i0), 1, 1.d0, 0.d0)
!--<mn||ej> to tmp(ej,mn) 
call itranspso(icore(i0), icore(i1), popb, popb, 0, vrtb, popb, 1, 1)
call iexpso(icore(i1), icore(i0), vrtb, popb, 1, 0, popb, popb, 0, 1, 1)
call VpqrmVsm_to_Vpqrs(icore(i0), t1(ifvo(2)), 1, 1, popb, &
                 vrtb, popb, 1, popb, vrtb, icore(i1), 1, 1.d0, 0.d0)
!--tmp(ej,mb) to embj
call sstgenso(icore(i1), icore(i0), nsize, vrtb, popb, popb, vrtb, &
              icore, 1, '1342')
call axpyso(nioi43, -1.d0, icore(i0), 1, wmbej, 1)
!
!this is to do wmbej = wmbej + 0.5*t2(bf,jn)*<ef||mn>
!
!----<ef||mn>*T2(fb,jn)
!iabij(ef,mn) to iabij(em,fn)
call iexpso(iabij(ioi3(3)), icore(i2), vrtb, vrtb, 0, 1, &
                    popb, popb, 0, 0, 1)
call iexpso(icore(i2), icore(i1), vrtb, vrtb, 1, 0, &
                    popb, popb, 0, 1, 1)
call sstgenso(icore(i1), icore(i0), nsize, vrtb, vrtb, popb, popb,&
               icore, 1, '1324')
!
call iexpso(t2(ioi3(3)), icore(i1), vrtb, vrtb, 0, 1,&
                    popb, popb, 0, 0, 1)
call iexpso(icore(i1), icore(i2), vrtb, vrtb, 1, 0, &
                    popb, popb, 0, 1, 1)
call sstgenso(icore(i2), icore(i1), nsize, vrtb, vrtb, popb, popb, &
               icore, 1, '1324')
!
call VpqmnVrsmn_to_Vpqrs(icore(i0), icore(i1), 1, 1, &
                  vrtb, popb, 1, vrtb, popb, 1, vrtb, popb, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!---<eF||mN>*T2(bF,jN)
!  =<Fe||Nm>*T2(Fb,Nj) BBBB
call sstgenso(iabij(ioi3(2)), icore(i0), nsize, vrta, vrtb, popa, popb,&
               icore, 1, '1324')
call sstgenso(t2(ioi3(2)), icore(i1), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1324')
call VmnpqVmnrs_to_Vpqrs(icore(i0), icore(i1), 1, 1, &
                  vrta, popa, 1, vrtb, popb, 1, vrtb, popb, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!-------------------------------------------------------------------
! R2BBBBR: P(ij)P(ab)  T2BB(ae,im)*WMBEJ(em,bj)
!
 CALL IEXPSO(T2(ioi3(3)), ICORE(i1), vrtb, vrtb, 0, 1, popb, popb, 0, 0, 1)
 CALL IEXPSO(icore(i1), ICORE(i0), vrtb, vrtb, 1, 0, popb, popb, 0, 1, 1)
 CALL SSTGENSO(ICORE(i0), ICORE(i1), nsize, vrtb, vrtb, &
             popb, popb, ICORE, 1, '1324')
 CALL VpqmnVmnrs_to_Vpqrs(ICORE(i1), WMBEJ, 1, 1, &
                vrtb, popb, 1, vrtb, popb, 1, &
                vrtb, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), ICORE(i1),nsize, vrtb, popb, &
             vrtb, popb, ICORE, 1, '2413')
 call iassymso(icore(i1), icore(i0), 1, popb, popb, vrtb, vrtb, 1)
 call itranspso(icore(i0), icore(i1), popb, popb, 1, vrtb, vrtb, 0, 1)
 call iassymso(icore(i1), icore(i0), 1, vrtb, vrtb, popb, popb, 0)

 call axpyso(nioi33, 1.d0, icore(i0), 1, r2(ioi3(3)), 1)
!
!R2ABAB T2AB(Ae,Im)W(embj)
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1), nsize, vrta, vrtb, &
             popa, popb, icore, 1, '1324')
 CALL VpqmnVmnrs_to_Vpqrs(ICORE(i1), WMBEJ, 1, 1, &
                vrtb, popb, 1, vrta, popa, 1, &
                vrtb, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), icore(i1), nsize, &
           vrta, popa, vrtb, popb,ICORE,1,'1324')
 CALL AXPYSO(nioi32, 1.d0, ICORE(i1), 1, R2(ioi3(2)), 1)
  write(6,*)'norm of r2ab 2', nrm2so(nioi32, r2(ioi3(2)), 1) 
!
!====eMbJ BABA==========================================================
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa after BABA', nrm2so(nsize, t2(ioi3(1)), 1) 
call myicopy_g(wmbej_c(ioi4(4)), wmbej, nioi44)
  write(6,*)'norm of wmbej 1', nrm2so(nioi32, WMBEJ, 1) 
!iijka(Mn,Je)*t1(bn)
!
call itranspso(iijka(ioi2(2)), icore(i1), popa, popb, 1, popa, vrtb, 1, 1) 
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(2)), 1, 1, popb, & 
                  popa, vrtb, 1, popa, vrtb, icore(i0), 1, 1.d0, 0.d0)
! tmpe(jE,mB)
call sstgenso(icore(i0), icore(i1), nsize, popa, vrtb, popa, vrtb, &
              icore, 1, '2341')
call axpyso(nioi44, 1.d0, icore(i1), 1, wmbej, 1)
  write(6,*)'norm of wmbej 1', nrm2so(nioi32, WMBEJ, 1) 
!-----------this is to do wmbej = wmbej - t1(fj)*t1(bn)*<ef||mn>
!--<eF||Mn>*t1(FJ)*t1(bn)=-<Fe||Mn>*t1(FJ)*t1(bn
call itranspso(iabij(ioi3(2)), icore(i0), vrta, vrtb, 1, popa, popb, 1, 1)
call isymtrso(icore(i0), icore(i1), popa, popb, 1, 0, vrta, vrtb, 1,1, 1)
call VpqrmVms_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, vrta, &
                 popa, popb, 1, vrtb, popa, icore(i2), 1, 1.d0, 0.d0)
!--<Mn,eJ> to (eJ,Mn)
call itranspso(icore(i2), icore(i0), popa, popb, 1, vrtb, popa, 1, 1)
call VpqrmVsm_to_Vpqrs(icore(i0), t1(ifvo(2)), 1, 1, popb, &
                 vrtb, popa, 1, popa, vrtb, icore(i2), 1, 1.d0, 0.d0)
!--tmp(eJ,Mb) to eMbJ
call sstgenso(icore(i2), icore(i1), nsize, vrtb, popa, popa, vrtb, &
              icore, 1, '1342')
call axpyso(nioi44,  1.d0, icore(i1), 1, wmbej, 1)
  write(6,*)'norm of wmbej 1', nrm2so(nioi32, WMBEJ, 1) 
!
!this is to do wmbej = wmbej + 0.5*t2(bf,jn)*<ef||mn>
!---<eF|Mn>*t2(bF,Jn)=<Fe|Mn>*t2(Fb,Jn)
call sstgenso(iabij(ioi3(2)), icore(i0), nsize, vrta, vrtb, popa, popb,&
               icore, 1, '1423')
call sstgenso(t2(ioi3(2)), icore(i1), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1423')
call VmnpqVmnrs_to_Vpqrs(icore(i0), icore(i1), 1, 1, &
                  vrta, popb, 1, vrtb, popa, 1, vrtb, popa, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!----------------------------------------------------------------
!R2ABAB -T2AB(Ae,Mj)W(eM,bI)
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1), nsize, vrta, vrtb, &
                popa, popb, ICORE, 1, '2314')
  write(6,*)'norm of wmbej 1', nrm2so(nioi32, WMBEJ, 1) 
 CALL VmnpqVmnrs_to_Vpqrs(WMBEJ, ICORE(i1), 1, 1, &
                vrtb, popa, 1, vrtb, popa, 1, &
                vrta, popb, 1, icore(i2), 1, 1.d0, 0.d0)
  write(6,*)'norm of r2ab 2 1', nrm2so(nioi32, icore(i2), 1) 
 CALL SSTGENSO(icore(i2), ICORE(i1),nsize, &
               vrtb, popa, vrta, popb, ICORE,1,'3124')
 CALL AXPYSO(nioi32, 1.d0, ICORE(i1), 1, R2(ioi3(2)), 1)
  write(6,*)'norm of r2ab 2 2', nrm2so(nioi32, r2(ioi3(2)), 1) 
!
!====EMbj AABB======================================================
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa after AABB', nrm2so(nsize, t2(ioi3(1)), 1) 
call myicopy_g(wmbej_c(ioi4(5)), wmbej, nioi45)
!iijka(Mn,jE)*t1(bn)=-iijka(nM,jE)*t1(bn)
call itranspso(iijka(ioi2(4)), icore(i0), popb, popa, 1, popb, vrta, 1, 1) 
call isymtrso(icore(i0), icore(i1), popb, vrta, 1, 0, popb, popa, 1, 1, 1) 
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(2)), 1, 1, popb, & 
                  popb, vrta, 1, popa, vrtb, icore(i0), 1, 1.d0, 0.d0)
!---tmp(jE,Mb)
call sstgenso(icore(i0), icore(i1), nsize, popb, vrta, popa, vrtb, &
              icore, 1, '2341')
call axpyso(nioi45, -1.d0, icore(i1), 1, wmbej, 1)
!-----------this is to do wmbej = wmbej - t1(fj)*t1(bn)*<ef||mn>
!--<Ef||Mn>*t1(fj)*t1(bn)
call itranspso(iabij(ioi3(2)), icore(i1), vrta, vrtb, 1, popa, popb, 1, 1)
call VpqrmVms_to_Vpqrs(icore(i1), t1(ifvo(2)), 1, 1, vrtb, &
                 popa, popb, 1, vrta, popb, icore(i2), 1, 1.d0, 0.d0)
!--<Nm,Ej> to (Ej,Nm)
call itranspso(icore(i2), icore(i0), popa, popb, 1, vrta, popb, 1, 1)
call VpqrmVsm_to_Vpqrs(icore(i0), t1(ifvo(2)), 1, 1, popb, &
                 vrta, popb, 1, popa, vrtb, icore(i1), 1, 1.d0, 0.d0)
!--tmp(Ej,Mb) to EMbj
call sstgenso(icore(i1), icore(i2), nsize, vrta, popb, popa, vrtb, &
              icore, 1, '1342')
call axpyso(nioi45,  -1.d0, icore(i2), 1, wmbej, 1)
!
!this is to do wmbej = wmbej + 0.5*t2(bf,jn)*<ef||mn>
call iexpso(iabij(ioi3(1)), icore(i2), vrta, vrta, 0, 1, &
                    popa, popa, 0, 0, 1)
call iexpso(icore(i2), icore(i1), vrta, vrta, 1, 0, &
                    popa, popa, 0, 1, 1)
call sstgenso(icore(i1), icore(i0), nsize, vrta, vrta, popa, popa,&
               icore, 1, '1324')
!---<EF|MN>*t2(bF,jN)=<EF|MN>*t2(Fb,Nj)

call sstgenso(t2(ioi3(2)), icore(i2), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1324')
call VpqmnVmnrs_to_Vpqrs(icore(i0), icore(i2), 1, 1, &
                  vrta, popa, 1, vrta, popa, 1, vrtb, popb, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!---<Ef|Mn>*t2(bf,jn)
call iexpso(t2(ioi3(3)), icore(i2), vrtb, vrtb, 0, 1,&
                    popb, popb, 0, 0, 1)
call iexpso(icore(i2), icore(i0), vrtb, vrtb, 1, 0, &
                    popb, popb, 0, 1, 1)
call sstgenso(icore(i0), icore(i1), nsize, vrtb, vrtb, popb, popb, &
               icore, 1, '1324')
call sstgenso(iabij(ioi3(2)), icore(i2), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1324')
call VpqmnVrsmn_to_Vpqrs(icore(i2), icore(i1), 1, 1, &
                  vrtb, popb, 1, vrta, popa, 1, vrtb, popb, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!-----------------------------------------------------------
!R2ABAB T2AA(AE,IM)W(EM,bj)
 CALL IEXPSO(T2(ioi3(1)), ICORE(i1), vrta, vrta, 0, 1, popa, popa, 0, 0, 1)
 CALL IEXPSO(icore(i1),  ICORE(i0), vrta, vrta, 1, 0, popa, popa, 0, 1, 1)
 CALL SSTGENSO(ICORE(i0), ICORE(i1), nsize, vrta, vrta, &
             popa, popa, ICORE, 1, '1324')
 CALL VpqmnVmnrs_to_Vpqrs(ICORE(i1), WMBEJ, 1, 1, &
                vrta, popa, 1, vrta, popa, 1, &
                vrtb, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), icore(i1), nsize, &
           vrta, popa, vrtb, popb,ICORE,1,'1324')
 CALL AXPYSO(nioi32, 1.d0, ICORE(i1), 1, R2(ioi3(2)), 1)
  write(6,*)'norm of r2ab 2', nrm2so(nioi32, r2(ioi3(2)), 1) 
! R2BBBBR: P(ij)P(ab)  T2AB(Ea,Mi)*WMBEJ(EMbj)
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1),nsize, vrta, vrtb, &
             popa, popb, ICORE, 1, '1324')
 CALL VmnpqVmnrs_to_Vpqrs(ICORE(i1), WMBEJ, 1, 1, &
                vrta, popa, 1, vrtb, popb, 1, &
                vrtb, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), ICORE(i1),nsize, vrtb, popb, &
             vrtb, popb, ICORE, 1, '2413')
 call iassymso(icore(i1), icore(i0), 1, popb, popb, vrtb, vrtb, 1)
 call itranspso(icore(i0), icore(i1), popb, popb, 1, vrtb, vrtb, 0, 1)
 call iassymso(icore(i1), icore(i0), 1, vrtb, vrtb, popb, popb, 0)

 call axpyso(nioi33, 1.d0, icore(i0), 1, r2(ioi3(3)), 1)
!
!====emBJ BBAA=============================================================
call myicopy_g(wmbej_c(ioi4(6)), wmbej, nioi46)
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
 !write(6,*)'norm of wmbejbbaa ', nrm2so(nsize, wmbej, 1) 
! 
!iijka(mN,Je)*t1(BN)=-iijka(Nm,Je)*t1(BN)
call itranspso(iijka(ioi2(2)), icore(i0), popa, popb, 1, popa, vrtb, 1, 1) 
call isymtrso(icore(i0), icore(i1), popa, vrtb, 1, 0, popa, popb, 1, 1, 1) 
!nsize = idsymsoc(1, popa, vrta, 1, zorb, zorb, 1)
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, popa, & 
                 popa, vrtb, 1, popb, vrta, icore(i0), 1, 1.d0, 0.d0) 
!--tmp(Je,mB)
call sstgenso(icore(i0), icore(i1), nsize, popa, vrtb, popb, vrta, &
                 icore, 1, '2341') 
call axpyso(nioi46, -1.d0, icore(i1), 1, wmbej, 1)
!-----------this is to do wmbej = wmbej - t1(fj)*t1(bn)*<ef||mn>
!--<eF||mN>*t1(FJ)*t1(BN)=<Fe||Nm>*t1(FJ)*t1(BN)
call itranspso(iabij(ioi3(2)), icore(i0), vrta, vrtb, 1, popa, popb, 1, 1)
call isymtrso(icore(i0), icore(i1), popa, popb, 1, 0, vrta, vrtb, 1,1, 1)
call VpqrmVms_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, vrta, &
                 popa, popb, 1, vrtb, popa, icore(i2), 1, 1.d0, 0.d0)
!--<Mn,eJ> to (eJ,Mn)
call itranspso(icore(i2), icore(i0), popa, popb, 1, vrtb, popa, 1, 1)
! (eJ,Nm) to (eJ,mN)
call isymtrso(icore(i0), icore(i1), vrtb, popa, 1, 0, popa, popb, 1, 1, 1)
call VpqrmVsm_to_Vpqrs(icore(i1), t1(ifvo(1)), 1, 1, popa, &
                 vrtb, popa, 1, popb, vrta, icore(i2), 1, 1.d0, 0.d0)
!--tmp(eJ,mB) to emBJ
call sstgenso(icore(i2), icore(i1), nsize, vrtb, popa, popb, vrta, &
              icore, 1, '1342')
call axpyso(nioi46, -1.d0, icore(i1), 1, wmbej, 1)
!
!this is to do wmbej = wmbej + 0.5*t2(bf,jn)*<ef||mn>
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
 !write(6,*)'norm of wmbejbbaa 1', nrm2so(nsize, wmbej, 1) 
!
!---<eF|mN>*t2(BF,JN)=<Fe|Nm>*t2(BF,JN)
 nsize = idsymsoc(1, vrta,vrta, 0, popa, popa, 0) 
 !write(6,*)'norm of t2aa', nrm2so(nsize, t2(ioi3(1)), 1) 
call iexpso(t2(ioi3(1)), icore(i2), vrta, vrta, 0, 1,&
                    popa, popa, 0, 0, 1)
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 0) 
 !write(6,*)'norm of icore 00', nrm2so(nsize, icore(i2), 1) 
call iexpso(icore(i2), icore(i0), vrta, vrta, 1, 0, &
                    popa, popa, 0, 1, 1)
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1) 
 !write(6,*)'norm of icore 01', nrm2so(nsize, icore(i0), 1) 
call sstgenso(icore(i0), icore(i1), nsize, vrta, vrta, popa, popa, &
               icore, 1, '1324')
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1) 
 !write(6,*)'norm of icore 0', nrm2so(nsize, icore(i0), 1) 
call sstgenso(iabij(ioi3(2)), icore(i2), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '2413')
 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1) 
 !write(6,*)'norm of icore 1', nrm2so(nsize, icore(i1), 1) 
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
 !write(6,*)'norm of icore 2', nrm2so(nsize, icore(i2), 1) 
call VpqmnVrsmn_to_Vpqrs(icore(i2), icore(i1), 1, 1, &
                  vrta, popa, 1, vrtb, popb, 1, vrta, popa, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
 !write(6,*)'norm of wmbejbbaa 2', nrm2so(nsize, wmbej, 1) 
!---<ef|mn>*t2(Bf,Jn)=
call iexpso(iabij(ioi3(3)), icore(i2), vrtb, vrtb, 0, 1, &
                    popb, popb, 0, 0, 1)
call iexpso(icore(i2), icore(i1), vrtb, vrtb, 1, 0, &
                    popb, popb, 0, 1, 1)
call sstgenso(icore(i1), icore(i0), nsize, vrtb, vrtb, popb, popb,&
               icore, 1, '1324')
call sstgenso(t2(ioi3(2)), icore(i2), nsize, vrta, vrtb, popa, popb, &
               icore, 1, '1324')
call VpqmnVrsmn_to_Vpqrs(icore(i0), icore(i2), 1, 1, &
                  vrtb, popb, 1, vrtb, popb, 1, vrta, popa, 1, &
                  wmbej, 1, 0.5d0, 1.d0)
!-------------------------------------------------------------------------
! R2AAAAR: P(ij)P(ab) T2AB(Ae,Im)*WMBEJ(emBJ)
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
 !write(6,*)'norm of wmbejbbaa 3', nrm2so(nsize, wmbej, 1) 
 !write(6,*)'norm of r2aa 2', nrm2so(nioi31, r2(ioi3(1)), 1) 
 call sstgenso(t2(ioi3(2)), icore(i0), nsize, vrta, vrtb, &
              popa, popb, icore, 1, '1324')
 call VpqmnVmnrs_to_Vpqrs(icore(i0), wmbej, 1, 1, &
                vrtb, popb, 1, vrta, popa, 1, &
                vrta, popa, 1, icore(i2), 1, 1.d0, 0.d0)
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
 call sstgenso(icore(i2), icore(i1), nsize, vrta, popa, &
             vrta, popa, icore, 1, '2413')
 call iassymso(icore(i1), icore(i0), 1, popa, popa, vrta, vrta, 1)
 call itranspso(icore(i0), icore(i1), popa, popa, 1, vrta, vrta, 0, 1)
 call iassymso(icore(i1), icore(i0), 1, vrta, vrta, popa, popa, 0)
 call axpyso(nioi31, 1.d0, icore(i0), 1, r2(ioi3(1)), 1)
 nsize = idsymsoc(1, vrta,vrtb, 1, popa, popb, 1) 
  write(6,*)'norm of wmbejbbaa ', nrm2so(nsize, wmbej, 1) 
  write(6,*)'norm of r2aa 2', nrm2so(nioi31, r2(ioi3(1)), 1) 
!
!----------------------------------------------------------
!R2ABAB T2BB(be,jm)W(emAI)
 CALL IEXPSO(T2(ioi3(3)), ICORE(i1), vrtb, vrtb, 0, 1, popb, popb, 0, 0,1)
 CALL IEXPSO(icore(i1), ICORE(i0), vrtb, vrtb, 1, 0, popb, popb, 0, 1,1)
 CALL SSTGENSO(ICORE(i0), ICORE(i1), nsize, vrtb, vrtb, &
             popb, popb, ICORE, 1, '1324')
 CALL VmnpqVmnrs_to_Vpqrs(WMBEJ, ICORE(i1), 1, 1, &
                vrtb, popb, 1, vrta, popa, 1, &
                vrtb, popb, 1, icore(i2), 1, 1.d0, 0.d0)
 CALL SSTGENSO(icore(i2), icore(i1), nsize, &
           vrta, popa, vrtb, popb,ICORE,1,'1324')
 CALL AXPYSO(nioi32, 1.d0, ICORE(i1), 1, R2(ioi3(2)), 1)
  write(6,*)'norm of r2ab 2', nrm2so(nioi32, r2(ioi3(2)), 1) 
!
!----------------------------------------------------------------------

!
return
end
